Introducción

Este modelo abarca el período de tiempo desde 2019 hasta julio de 2024, con una frecuencia semanal.

Se bajan los datos

ruta_productos <- "/cloud/project/df_dif.xlsx"
excel_sheets(ruta_productos)
## [1] "Sheet 1"
productos <- as.data.frame(read_xlsx(ruta_productos, sheet = "Sheet 1", 
                                     col_names = T))
productos <- select(.data = productos, c("Fecha", "dif"))
colnames(productos) <- c("Fecha", "Totales")
productos$Semana <- format(x = productos$Fecha, format = c("%Y-%U"))
nrow(productos)
## [1] 694
head(productos)
##        Fecha    Totales  Semana
## 1 2019-07-03 -2.8586186 2019-26
## 2 2019-07-04  0.6996184 2019-26
## 3 2019-07-05  0.8669633 2019-26
## 4 2019-07-06  0.1055037 2019-26
## 5 2019-07-08  0.5360249 2019-27
## 6 2019-07-09 -1.4721819 2019-27

Agrupando por semana

productos <- productos %>%
  group_by(Fecha = as.character(Semana)) %>%
  summarize(Totales = sum(Totales), 
            .groups = "keep")
head(productos)
## # A tibble: 6 × 2
## # Groups:   Fecha [6]
##   Fecha   Totales
##   <chr>     <dbl>
## 1 2019-26  -1.19 
## 2 2019-27  -1.92 
## 3 2019-28   1.17 
## 4 2019-29  -0.484
## 5 2019-30  -0.675
## 6 2019-31   1.60

Serie temporal semanal.

productos_sem_ts <- ts(data = productos$Totales,start = 1,frequency = 1)
productos_sem_xts <- as.xts(productos_sem_ts, dateFormat = "POSIXct")

Gráficas de la serie temporal.

Raíz unitaria

urca::ur.df(productos_sem_ts)
## 
## ############################################################### 
## # Augmented Dickey-Fuller Test Unit Root / Cointegration Test # 
## ############################################################### 
## 
## The value of the test statistic is: -20.7143

El valor del estadístico de Dickey-Fuller es -20.7143 Este resultado, significativamente menor que el valor crítico, nos permite rechazar la hipótesis nula de que la serie tiene una raíz unitaria a un nivel de significancia del 5%. En consecuencia, se concluye que la serie de tiempo es estacionaria.

kpss.test(productos_sem_ts)
## Warning in kpss.test(productos_sem_ts): p-value greater than printed p-value
## 
##  KPSS Test for Level Stationarity
## 
## data:  productos_sem_ts
## KPSS Level = 0.014359, Truncation lag parameter = 4, p-value = 0.1

KPSS Level = 0.014359, Truncation lag parameter = 4, p-value = 0.1 Ho:La serie de tiempo es estacionaria. Ha:La serie de tiempo no es estacionaria. Dado que el valor p es 0.1, mayor al nivel de significancia de 0.05, no se rechaza la hipótesis nula.

ACF Y PACF

ggAcf(productos_sem_ts, col = "red", lag.max = 52)

ggPacf(productos_sem_ts, col = "blue", lag.max = 52)

División de la serie temporal en el conjunto de entrenamiento y de prueba.

dividida_sem_ts <- ts_split(productos_sem_ts, 
                               sample.out = round(length(productos_sem_ts)*0.2))

entrena_productos_sem_ts <- dividida_sem_ts$train

prueba_productos_sem_ts <- dividida_sem_ts$test

Modelo

modelo_prod_sem <- auto.arima(entrena_productos_sem_ts, stationary = T, stepwise = F)
summary(modelo_prod_sem )
## Series: entrena_productos_sem_ts 
## ARIMA(5,0,0) with zero mean 
## 
## Coefficients:
##           ar1      ar2      ar3      ar4      ar5
##       -0.8420  -0.6320  -0.4051  -0.4041  -0.2779
## s.e.   0.0693   0.0877   0.0943   0.0875   0.0693
## 
## sigma^2 = 2.384:  log likelihood = -357.63
## AIC=727.26   AICc=727.71   BIC=746.87
## 
## Training set error measures:
##                       ME     RMSE      MAE MPE MAPE      MASE       ACF1
## Training set -0.02939907 1.523993 1.238329 Inf  Inf 0.4019376 -0.0116012
# AIC=727.26   AICc=727.71   BIC=746.87
# ARIMA(5,0,0) with zero mean

Residuales

checkresiduals(modelo_prod_sem, col = "red") # p-value = 0.4654

## 
##  Ljung-Box test
## 
## data:  Residuals from ARIMA(5,0,0) with zero mean
## Q* = 4.6091, df = 5, p-value = 0.4654
## 
## Model df: 5.   Total lags used: 10

Pronósticos

pronostico_sem_prod <- forecast(modelo_prod_sem , 
                                   h = length(prueba_productos_sem_ts), 
                                   level = 0.95)

Gráfica de pronósticos

Exactitud del modelo

accuracy(prueba_productos_sem_ts, pronostico_sem_prod$mean)
##                   ME     RMSE      MAE      MPE    MAPE       ACF1 Theil's U
## Test set 0.004717644 2.518968 1.940655 527284.5 1593630 -0.3556576  239.8227
#                   ME    RMSE      MAE      MPE    MAPE 
#Test set 0.004717644 2.518968 1.940655 527284.5 1593630

Exactitud a 10 semanas

accuracy(prueba_productos_sem_ts[1:10], pronostico_sem_prod$mean[1:10])
##                  ME     RMSE      MAE     MPE   MAPE
## Test set -0.2624565 2.624804 2.082836 -399950 401503
#                  ME     RMSE      MAE    MPE        MAPE
# Test set -0.2624565 2.624804 2.082836 -399950 401503